Unit BGeneratorUnit;

{$mode objfpc}{$H+}

Interface

Uses
  Classes, SysUtils, strutils, Math, BPeaUnit;

Type BFileKind = (fkModel, fkController, fkConsts, fkCommonConsts, fkSQL,
  fkTestCase);

Type

{ BGeneratorClass }

 BGeneratorClass = Class
  Protected
    bUnitFile: TStringList;
    bPea: BPeaClass;
    bPeasPath: String;
    bProjectName: String;

    //** Initialize Unit File
    Procedure InitializeUnitFile(Const aKind: BFileKind); Virtual;
    //** Find Index of line with //@<Section>Start or //@<Section>Stop
    Function FindSectionLine(Const aSection: String;
      Const aStart: Boolean): Integer;
    //** Remove all lines between Start and Stop
    Function ClearSection(Const aSection: String): Integer;
    //** Return Idented with spaces string
    Function GetIdentString(Const aSize: Integer): String; Inline;
    //** Add line to bUnitFile
    Procedure AddLine(aLine: String; Const aIdent: Integer;
      Var aIndex: Integer);
    //** Add formatted line to bUnitFile
    Procedure AddLine(Const aLineMask: String; Const aParams: Array Of Const;
      Const aIdent: Integer; Var aIndex: Integer);
    //** Add formatted lines to bUnitFile
    Procedure AddLines(Const aLinesMask: String; Const aParams: Array Of Const;
      Var aIndex: Integer);
    Procedure AddBegin(Const aIdent: Integer; Var aIndex: Integer);
    Procedure AddEnd(Const aIdent: Integer;
      Var aIndex: Integer; Const aWithSemicolon: Boolean = TRUE);
    Procedure AddEmptyLine(Var aIndex: Integer);
    Procedure AddElse(Const aIdent: Integer; Var aIndex: Integer);

    Procedure AddPropertyDeclare(Const aPeaProperty: BPeaPropertyClass;
      Const aIdent: Integer; Var aIndex: Integer);
    //** Save Plural Peas
  Public
     //** Path to Peas of project
    Property PeaPath: String Read bPeasPath;
    //** Target pea. Should set before update
    Property Pea: BPeaClass Read bPea Write bPea;

    Procedure Update; Virtual; Abstract;
    Procedure SavePeaUnit; Virtual; Abstract;

    Constructor Build(Const aPeaPath, aProjectName: String);
    Destructor Burn;
End;

Implementation

ResourceString
  rsTemplatesDir = 'Templates/';
  rsPlainModel = 'plainmodel.ppp';
  rsTreeModel = 'treemodel.ppp';
  rsHolderModel = 'holdermodel.ppp';

  rsPlainController = 'plaincontroller.ppp';
  rsTreeController = 'treecontroller.ppp';
  rsHolderController = 'holdercontroller.ppp';

  rsConsts = 'consts.ppp';

  rsBegin = 'Begin';
  rsEnd = 'End;';
  rsEndWOSemicolon = 'End';

Procedure BGeneratorClass.InitializeUnitFile(Const aKind: BFileKind);
Var
  aTemplate: String;
Begin
  aTemplate := rsTemplatesDir;
  Case aKind Of
    fkModel:
      Case Pea.Kind Of
        pkPlain: aTemplate += rsPlainModel;
        pkTree: aTemplate += rsTreeModel;
        pkHolder: aTemplate += rsHolderModel;
      End;
    fkController:
      Case Pea.Kind Of
        pkPlain: aTemplate += rsPlainController;
        pkTree: aTemplate += rsTreeController;
        pkHolder: aTemplate += rsHolderController;
      End;
    fkConsts:
      aTemplate += rsConsts;
  End;
  If FileExists(aTemplate) Then
    bUnitFile.LoadFromFile(aTemplate);
  bUnitFile.Text := Format(bUnitFile.Text,
    [{0}Pea.ID, {1}Pea.Caption, {2}Pea.PluralCaption, {3}UpCase(Pea.Caption),
      {4}Pea.HoldingPea.Caption, {5}Pea.HoldingPea.PluralCaption,
      {6}'', {7}'', {8}'', {9}'', {10}bProjectName]);
End;

Function BGeneratorClass.FindSectionLine(Const aSection: String;
  Const aStart: Boolean): Integer;
Const
  STR_START = 'Start';
  STR_STOP = 'Stop';
  MASK_SECTION = '//@%s%s';
Var
  i: Integer;
Begin
  Result := -1;
  For i := 0 To bUnitFile.Count - 1 Do
    If Trim(bUnitFile[i]) = Format(MASK_SECTION,
      [aSection, IfThen(aStart, STR_START, STR_STOP)]) Then
        Exit(i);
End;

Function BGeneratorClass.ClearSection(Const aSection: String): Integer;
Var
  i, aIndex: Integer;
  aClearStart, aClearStop: Integer;
  //aClear: BIntegersList;
Begin
  Result := -1;
  aClearStart := FindSectionLine(aSection, TRUE);
  aClearStop := FindSectionLine(aSection, FALSE);
  If (aClearStart = -1) Or (aClearStop = -1) Then Exit;
  For i := aClearStop - 1 DownTo aClearStart + 1 Do
    bUnitFile.Delete(i);
  Result := aClearStart + 1;
End;

Function BGeneratorClass.GetIdentString(Const aSize: Integer): String;
Var
  i: Integer;
Begin
  Result := '';
  For i := 1 To aSize Do Result += #32;
End;

Procedure BGeneratorClass.AddLine(aLine: String; Const aIdent: Integer;
  Var aIndex: Integer);
Const
  STR_READ = ' Read ';
  STR_WRITE = ' Write ';
Var
  aOffset: Integer = 0;
  aBreak: Integer = 0;
Begin
  If aIndex = -1 Then Exit;
  Repeat
    If (aBreak > 0) And Not(aBreak = Length(aLine)) Then
      Delete(aLine, 1, aBreak);
    aLine := GetIdentString(aIdent + aOffset) + Trim(aLine);
    If Length(aLine) < 80 Then
      bUnitFile.Insert(aIndex, aLine)
    Else
      Begin
        aBreak := Max(RPosex(';', aLine, 70), RPosEx('.', aLine, 70));
        aBreak := Max(aBreak, RPosex(',', aLine, 70));
        aBreak := Max(aBreak, RPosex('(', aLine, 70));
        aBreak := Max(aBreak, RPosex(STR_READ, aLine, 70));
        aBreak := Max(aBreak, RPosex(STR_WRITE, aLine, 70));
        aBreak := Max(aBreak, RPosex(#32, aLine, 70));
        bUnitFile.Insert(aIndex, Copy(aLine, 1, aBreak));
      End;
    aOffset := 2;
    Inc(aIndex);
  Until (Length(aLine) < 80) Or (aBreak = 0);
End;

Procedure BGeneratorClass.AddLine(Const aLineMask: String;
  Const aParams: Array Of Const; Const aIdent: Integer; Var aIndex: Integer);
Begin
  AddLine(Format(aLineMask, aParams), aIdent, aIndex);
End;

Procedure BGeneratorClass.AddLines(Const aLinesMask: String;
  Const aParams: Array Of Const; Var aIndex: Integer);
Var
  i, j, aCount: Integer;
  aLines, aLine: String;
  aIdent: Integer;
Begin
  aLines := Format(aLinesMask, aParams);
  For i := 0 To WordCount(aLinesMask, ['\']) - 1 Do
    Begin
      aIdent := 0;
      aLine := ExtractWord(i, aLines, ['\']);
      For j := 1 To Length(aLine) Do
        If aLine[j] = #32 Then aIdent += 1
        Else Break;
      AddLine(aLine, aIdent, aIndex);
    End;
End;

Procedure BGeneratorClass.AddBegin(Const aIdent: Integer; Var aIndex: Integer);
Begin
  AddLine(rsBegin, aIdent, aIndex);
End;

Procedure BGeneratorClass.AddEnd(Const aIdent: Integer; Var aIndex: Integer;
  Const aWithSemicolon: Boolean);
Begin
  If aWithSemicolon Then AddLine(rsEnd, aIdent, aIndex)
  Else AddLine(rsEndWOSemicolon, aIdent, aIndex)
End;

Procedure BGeneratorClass.AddEmptyLine(Var aIndex: Integer);
Begin
  AddLine('', 0, aIndex);
End;

Procedure BGeneratorClass.AddElse(Const aIdent: Integer; Var aIndex: Integer);
Begin
  AddLine('Else', aIdent, aIndex);
End;

Procedure BGeneratorClass.AddPropertyDeclare(Const aPeaProperty: BPeaPropertyClass;
  Const aIdent: Integer; Var aIndex: Integer);
Begin
  AddLine('a%0:s: B%0:sClass;', [aPeaProperty.Pea.Caption], aIdent, aIndex);
End;

Constructor BGeneratorClass.Build(Const aPeaPath, aProjectName: String);
Begin
  bUnitFile := TStringList.Create;
  bPeasPath := aPeaPath;
  bProjectName := aProjectName;
End;

Destructor BGeneratorClass.Burn;
Begin
  bUnitFile.Free;
End;

End.
